home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 6 / Night Owl's Shareware - PDSI-006 - Night Owl Corp (1990).iso / 006a / pifrac.zip / PIFRAC.FOR < prev   
Text File  |  1988-01-08  |  2KB  |  83 lines
  1.  
  2.     PROGRAM PIFRAC
  3.  
  4. C  RATIONAL FRACTION APPROXIMATIONS
  5.  
  6.     IMPLICIT DOUBLE PRECISION (D)
  7.  
  8. C    DPI=2.D00*DASIN(1.D00)
  9. C    DPI=DEXP(1.D00)
  10. 2    WRITE (*,'(A)') ' Rational fraction approximations: Choices:'
  11.     WRITE (*,'(A)') '    1. Pi to some integer power < 10'
  12.     WRITE (*,'(A)') '    2. e  to some integer power <10'
  13.     WRITE (*,'(A)') '    3. Square root of an integer <100'
  14. 5    WRITE (*,'(A)') ' Choose by number (0 for exit): '
  15.     READ (*,'(I1)') K
  16.     IF (K.EQ.0) GOTO 110
  17.     WRITE (*,'(A\)') 'What integer? '
  18.     READ (*,'(I2)') L
  19.     IF (K.EQ.1) THEN
  20.       DPI=(2.D00*DASIN(1.D00))**L
  21.     ELSEIF (K.EQ.2) THEN
  22.       DPI=DEXP(DFLOAT(L))
  23.     ELSEIF (K.EQ.3) THEN
  24.       DPI=DSQRT(DFLOAT(L))
  25.     ELSE
  26.       GOTO 5
  27.     ENDIF
  28.     NTBL=JFIX(DPI)
  29.     NBBL=1
  30.     NTBG=NTBL+1
  31.     NBBG=1
  32.     NTOP=NTBL
  33.     NBOT=NBBL
  34.     DBEST=.999D00
  35. C    DBEST=1.25D-03
  36. C    NTOP=3
  37. C    NBOT=1
  38. C    NTBG=22
  39. C    NBBG=7
  40. C    NTBL=3
  41. C    NBBL=1
  42. C    NN=0
  43. C    WRITE (*,'(A)') '      Rational fraction approximations to pi'
  44.     WRITE (*,'(A)') ' '
  45.     WRITE (*,'(A)') '   Numerator Denominator       Ratio '//
  46.      &'                Error'
  47. C    D=DFLOAT(3)
  48. C    D1=D-DPI
  49. C    WRITE (*,*) 3,1,D,D1
  50. C    D=DFLOAT(22)/DFLOAT(7)
  51. C    D1=D-DPI
  52. C    WRITE (*,*) 22,7,D,D1
  53. 10    D=DFLOAT(NTOP)/DFLOAT(NBOT)
  54.     DEL=D-DPI
  55.     DELABS=DABS(DEL) 
  56.     IF (DELABS.LT.DBEST) THEN
  57.             WRITE (*,*) NTOP,NBOT,D,DEL
  58.         IF (DELABS.LT.2.D-18) GOTO 100
  59.         DBEST=DELABS       
  60.         IF (DEL.GT.0.D00) THEN
  61.             NTBG=NTOP
  62.             NBBG=NBOT     
  63.             ELSE
  64.             NTBL=NTOP
  65.             NBBL=NBOT
  66.             ENDIF            
  67.       ENDIF    
  68.     IF (DEL.GT.0.D00) THEN      
  69.         X=FLOAT(NTOP)+FLOAT(NTBL)
  70.             IF (X.GT.2.**32-1) GOTO 100
  71.         NTOP=NTOP+NTBL
  72.         NBOT=NBOT+NBBL
  73.     ELSE
  74.         X=FLOAT(NTOP)+FLOAT(NTBG)
  75.         IF (X.GT.2.**31-1) GOTO 100
  76.         NTOP=NTOP+NTBG
  77.         NBOT=NBOT+NBBG
  78.     ENDIF                 
  79.     GOTO 10
  80. 100    WRITE (*,'(A)') ' '
  81.        GOTO 2
  82. 110    END
  83.